home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1991 June
/
1991-06.d64
/
geoinfo editor
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
7KB
|
258 lines
0 clr
4 rem copyright 1991 - compute publications intl ltd - all rights reserved
5 rem by henning vahlenkamp
10 rem***set-up***
20 if peek(65534)=23 and peek(215)=128 then40
30 poke53280,6:poke53281,6:xx=3:tx=4:goto60
40 poke53265,11:poke53296,1:sys52684,3,26
50 xx=23:xx$="":tx=24
60 dn=8:t=18:open1,dn,15
70 print#1,"m-r"chr$(198)chr$(229)chr$(1)
80 get#1,by$:if asc(by$)=255 then t=40:fl=1
90 close1:dim c$(16),t$(13),m$(15)
100 for l=1 to 32
110 hb$=hb$+chr$(192):s$=s$+" ":next
120 for l=. to 10:read ch$(l),ll(l):next
130 for l=. to 16:read c$(l):next
140 for l=. to 2:read q$(l):next
150 for l=1 to 15:read m$(l):next
160 h$="[221]":z$=chr$(.):ss$=chr$(160):hm$=""
170 rt$="":dn$="":rs$=""
180 for l=1 to xx:r$=r$+rt$:next
190 for l=1 to 21:dm$=dm$+dn$:next
200 for l=. to 5
210 rt$=rt$+rt$+xx$:dn$=dn$+dn$:next
220 dn$=hm$+dn$:hx$="0123456789abcdef"
230 rem***screen***
240 printchr$(14)"[147]"r$"[176]"hb$"[174]"
250 printr$h$"**"h$" "m$(1)" "h$"**"h$
260 printr$"[171]"hb$"[179]"
270 for l=1 to 10:printr$h$s$h$:next
280 printr$h$left$(s$,9)left$(hb$,23)"[179]"
290 for l=1 to 4
300 printr$h$"[155][204]"chr$(l+48)""h$left$(s$,29)h$:next
310 printr$"[173][192][192][177]"left$(hb$,29)"[189]"
320 printr$"[192]"hb$"[192]":print:printr$"[192]"hb$"[192]"
330 printr$"[155]"m$(2):printr$m$(3);
340 rem***main***
350 printhm$left$(dn$,5);
360 for l=. to 10
370 printleft$(rt$,tx)"[155]"ch$(l)"":next
380 gosub1550
390 printleft$(dn$,mc+5)left$(rt$,tx)"[155]"rs$left$(ch$(mc),len(ch$(mc))-1)""
400 get k$:if k$="" then400
410 if k$=chr$(13) then530
420 if k$="d" then740
430 if k$="c" then860
440 if k$="r" then920
450 if k$="w" then1630
460 if k$="p" then1970
470 if k$="q" then2370
480 if k$="" then mc=mc+1:if mc>10 then mc=.
490 if k$="[145]" then mc=mc-1:if mc<. then mc=10
500 printleft$(dn$,m2+5)left$(rt$,tx)"[155]"left$(ch$(m2),len(ch$(m2))-1)""
510 m2=mc:goto390
520 rem***change***
530 tm$=t$(mc):gosub2190
540 if t$(.)="" then printm$(8):gosub2210:gosub2200:goto400
550 if mc<>2 and mc<>4 and mc<>5 then ln=ll(mc):gosub2060
560 on mc+1 goto570,570,580,570,580,580,590,570,620,650,680
570 t$(mc)=tx$:goto710
580 printm$(9):gosub2210:gosub2200:goto400
590 mm=val(mid$(tx$,1,2)):dd=val(mid$(tx$,3,2)):yy=val(mid$(tx$,5,2))
600 hh=val(mid$(tx$,7,2)):nn=val(mid$(tx$,9,2))
610 fg=1:gosub1340:goto710
620 if tx$="y" then t$(8)="yes":wp=wp or 64
630 if tx$="n" then t$(8)="no":wp=wp and 191
640 goto710
650 ad$=tx$:t$(9)="":q=1:for l=. to 2
660 t$(9)=t$(9)+q$(l)+mid$(tx$,q,4)
670 q=q+4:next:goto710
680 x=val(tx$):if x<1 or x>4 then400
690 ln=29:if x=4 then ln=8
700 gosub2060:t$(9+x)=tx$:goto350
710 if tx$="" then t$(mc)=tm$:goto400
720 goto350
730 rem***directory***
740 print"[147]":x=11:y=12
750 open1,dn,.,"$0":get#1,v1$
760 get#1,v1$,v1$,v1$,v1$,v2$,v3$
770 printasc(v1$+z$)+asc(v2$+z$)*256v3$;
780 for l=. to x
790 get#1,v1$,v2$:printv1$v2$;:next
800 get k$:if k$="q" then830
810 if k$<>"" then gosub2210
820 print:if v2$<>"" then x=y:goto760
830 close1
840 print:print m$(10):gosub2210:goto240
850 rem***disk command***
860 ln=33:gosub2060:if tx$="" then900
870 open1,dn,15:print#1,tx$
880 input#1,en,em$,et,es:gosub2190
890 printen;em$;et;es:gosub2210
900 close1:gosub2200:goto400
910 rem***read & decode***
920 fi$="":ln=16:s=1:if fl then s=3
930 gosub2060:if tx$="" then400
940 gosub2190:printm$(6)
950 open1,dn,15,"i0":open2,dn,2,"#"
960 print#1,"u1";2;.;t;s
970 get#2,tr$,se$:tr$=tr$+z$:se$=se$+z$
980 for vl=5 to 244 step 32
990 print#1,"b-p";2;vl
1000 for i=1 to 16:get#2,by$
1010 if by$=ss$ then1030
1020 fi$=fi$+by$:next i
1030 if fi$=tx$ then1080
1040 fi$="":next vl
1050 if asc(tr$)<>. then s=asc(se$):goto960
1060 gosub2200:gosub2190:printm$(5)
1070 gosub2210:goto1530
1080 zz$=s1$:s1$="":print#1,"b-p";2;vl-3
1090 for l=1 to 30
1100 get#2,by$:if by$="" then by$=z$
1110 if l=20 and by$=z$ then s1$=zz$:gosub2190:printm$(15):gosub2210:goto1530
1120 s1$=s1$+by$:next
1130 s2$="":ad$="":ss=s
1140 for l=. to 13:t$(l)="":next
1150 kk=144:if fl then kk=4
1160 print#1,"u1";2;.;t;.:print#1,"b-p";2;kk
1170 for l=1 to 16
1180 get#2,by$:if by$=ss$ then1200
1190 t$(1)=t$(1)+by$:next
1200 tk=asc(mid$(s1$,20,1)):sk=asc(mid$(s1$,21,1))
1210 print#1,"u1";2;.;tk;sk
1220 print#1,"b-p";2;68
1230 for l=1 to 187:get#2,by$:if by$="" then by$=z$
1240 s2$=s2$+by$:next:close2:close1
1250 t$(.)=tx$:t$(2)=c$(asc(mid$(s1$,23,1)))
1260 for l=10 to 27
1270 by$=mid$(s2$,l,1):if by$=z$ then1290
1280 t$(3)=t$(3)+by$:next
1290 t$(4)=c$(asc(mid$(s1$,22,1))+15)
1300 x=asc(mid$(s1$,29,1))+asc(mid$(s1$,30,1))*256
1310 t$(5)=str$(int(x/4))+"k "+str$(x)+" blocks"
1320 mm=asc(mid$(s1$,25,1)):dd=asc(mid$(s1$,26,1)):yy=asc(mid$(s1$,24,1))
1330 hh=asc(mid$(s1$,27,1)):nn=asc(mid$(s1$,28,1))
1340 t$(6)=str$(mm)+"/"+str$(dd)+"/"+str$(yy)
1350 x$=str$(nn):if len(x$)=2 then x$=" 0"+right$(x$,1)
1360 t$(6)=t$(6)+" "+str$(hh)+":"+x$
1370 if fg then fg=.:return
1380 for l=30 to 47
1390 by$=mid$(s2$,l,1):if by$=z$ then1410
1400 t$(7)=t$(7)+by$:next
1410 wp=asc(left$(s1$,1))
1420 if wp>133 then t$(8)="yes":goto1440
1430 t$(8)="no"
1440 q=2:for l=2 to 6 step 2
1450 x=asc(mid$(s2$,l+2,1))+asc(mid$(s2$,l+3,1))*256
1460 gosub2240:ad$=ad$+a$:t$(9)=t$(9)+q$(l-q)+a$
1470 q=q+1:next
1480 x=93:for i=10 to 13
1490 for l=x to x+28
1500 by$=mid$(s2$,l,1):if by$=z$ then1530
1510 t$(i)=t$(i)+by$
1520 next l:x=x+29:next i
1530 close2:close1:gosub2200:goto380
1540 rem***update screen***
1550 printhm$""
1560 for l=. to 9
1570 printtab(tx+10)t$(l)left$(s$,21-len(t$(l)))
1580 next:print
1590 for l=10 to 13
1600 printtab(tx+3)t$(l)left$(s$,29-len(t$(l)))
1610 next:return
1620 rem***encode & write***
1630 gosub2190:if t$(.)="" then printm$(12):gosub2210:gosub2200:goto400
1640 printm$(13):gosub2210
1650 if k$<>"y" then1950
1660 gosub2190:print m$(7):for l=. to 5:tt$(l)="":next
1670 for i=. to 1
1680 x=len(t$(i)):tt$(i)=t$(i)
1690 if x<16 then for j=1 to 16-x:tt$(i)=tt$(i)+ss$:next j
1700 next i
1710 l=2:for i=3 to 7 step 4
1720 x=len(t$(i)):tt$(l)=t$(i)
1730 if x<18 then for j=1 to 18-x:tt$(l)=tt$(l)+z$:next j
1740 l=3:next i
1750 dt$=chr$(yy)+chr$(mm)+chr$(dd)+chr$(hh)+chr$(nn)
1760 for l=1 to 9 step 4
1770 x$=mid$(ad$,l,4):gosub2290
1780 hi=int(x/256):lo=x-hi*256
1790 tt$(4)=tt$(4)+chr$(lo)+chr$(hi):next
1800 for l=10 to 13:tt$(5)=tt$(5)+t$(l):next
1810 x=len(tt$(5))
1820 if x<95 then for l=1 to 95-x:tt$(5)=tt$(5)+z$:next
1830 s1$=chr$(wp)+mid$(s1$,2,2)+tt$(.)+mid$(s1$,20,4)+dt$+mid$(s1$,29,2)
1840 tm$=chr$(wp)+mid$(s2$,2,2)+tt$(4)+tt$(2)+mid$(s1$,28,2)
1850 s2$=tm$+tt$(3)+mid$(s2$,48,45)+tt$(5)
1860 open1,dn,15,"i0":open2,dn,2,"#"
1870 print#1,"u1";2;.;t;ss:print#1,"b-p";2;vl-3
1880 print#2,s1$;:print#1,"u2";2;.;t;ss
1890 close2:close1:open1,dn,15,"i0":open2,dn,2,"#"
1900 print#1,"u1";2;.;t;.:print#1,"b-p";2;kk
1910 print#2,tt$(1);:print#1,"u2";2;.;t;.
1920 close2:close1:open1,dn,15,"i0":open2,dn,2,"#"
1930 print#1,"u1";2;.;tk;sk:print#1,"b-p";2;68
1940 print#2,s2$;:print#1,"u2";2;.;tk;sk
1950 close2:close1:gosub2200:goto400
1960 rem***printer dump***
1970 gosub2190
1980 if t$(.)="" then printm$(11):gosub2210:goto2040
1990 open4,4,7:close4:if st<>0 then printm$(14):gosub2210:goto2040
2000 printm$(4):open4,4,7
2010 for l=. to 9:print#4,ch$(l)t$(l):next
2020 print#4:for l=10 to 13
2030 print#4,"[204]"chr$(l+39)":"t$(l):next:close4
2040 gosub2200:goto400
2050 rem***command line***
2060 tx$="":gosub2190
2070 get k$:v=asc(k$+z$)
2080 if (v>31 and v<96) or (v>192 and v<219) or v=20 then2110
2090 if v=13 then2170
2100 goto2070
2110 if tx$="" and v=20 then2070
2120 if len(tx$)>=ln and v<>20 then2070
2130 printk$;
2140 if v>192 then k$=chr$(v-96)
2150 if v<>20 then tx$=tx$+k$:goto2070
2160 tx$=left$(tx$,len(tx$)-1):goto2070
2170 gosub2200:return
2180 rem***set, clear, wait***
2190 printhm$dm$r$":";:return
2200 printhm$dm$r$s$" "hm$:return
2210 get k$:if k$="" then2210
2220 return
2230 rem***dec-hex, hex-dec***
2240 a$="":z=1:for i=1 to 3
2250 v=int(x/(4096/z)):a$=a$+mid$(hx$,v+1,1)
2260 x=int(x-v*(4096/z))
2270 z=z*16:next
2280 a$=a$+mid$(hx$,x+1,1):return
2290 a$="":x=.:for i=1 to 4
2300 a$=mid$(x$,5-i,1)
2310 for j=1 to 16
2320 if a$=mid$(hx$,j,1) then2340
2330 next j
2340 x=x+(16^(i-1))*(j-1):next i:if x>65535 then x=.
2350 return